; ; (require :agraph)

(in-package :db.agraph.user)  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; print an item with a following tab
; uses none
; used by print-with-cr
(defun print-with-tab( e &optional out )
  (format out "~a~a" e #\tab))

; print a list separated by tabs with 
; with a carriage return at the end
; uses print-with-tab
; used by pwcr
(defun print-with-cr ( l &optional out )
  (mapcar #'(lambda(x) (print-with-tab x out)) l)
  (format out "~%"))

; print a list of lists 
; top level list is separated by carriage returns
; bottom level list is separated by tabs
; this therefore makes a nice 2-d array
; uses print-with-cr
; used by print-nested-file
(defun pwcr (l &optional out &key s )
  (let* 
      (
       (ll (if s (sort l #'string-lessp) l))
       )
    
  (mapcar #'(lambda(x) (print-with-cr x out)) ll)
    (length ll)
    
    ))

(defmacro pwcrt (l) `(pwcr ,l t))

; print-nested-file
; writes the 2-d array generated by pwcr into a file
; uses pwcr
; used by none
;; --> commented away; r-run is not portable away from the windows platform.
;;;(defun print-nested-file (l file-name &key column-headers)
;;;  (with-open-file (out file-name :direction :output :if-exists :supersede)
;;;    (when column-headers (print-with-cr column-headers out))
;;;    (pwcr l out)
;;;    )
;;;  (r-run::xl file-name)
;;;  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; functors

; done-ness
(<-- (is-done ?x) (q- ?x !pm:COMPLETION-DATE ?a) )
(<-- (is-not-done ?x) (not (is-done ?x)))

(<-- (doneness ?d ?id) (q- ?id !pm:DONE ?d) \!)
(<-  (doneness !"0" ?id) \!)

; id
(<-- (id-of ?id ?it) (q- ?it !pm:ID ?id) \!)
(<-  (id-of ?it ?it) \!)

; name
(<-- (name-of ?name ?i) (q- ?i !pm:NAME ?name) \!)
(<-  (name-of "NA" ?i) \!)

; priority
(<-- (priority-of ?p ?i) (q- ?i !pm:PRIORITY ?p) \!)
(<-  (priority-of 99 ?i) \!)


; description
(<-- (description-of ?d ?it) (q- ?it !pm:DESCRIPTION ?d) \!)
(<-  (description-of "NA" ?it) \!)

(defun left-10 (d) (subseq d 0 10))

; date
(<-- (date-of ?date ?i) 
     (q- ?i !pm:DATE ?d) 
     (q- ?d !t:time ?t) 
     (upi-to-date-string ?t ?date) 
     \!)
(<-  (date-of "NA" ?i) \!)

; target date
(<-- (target-date-of ?date ?i) 
     (q- ?i !pm:TARGET-DATE ?d) 
     (q- ?d !t:time ?t) 
     (upi-to-date-string ?t ?date) 
     \!)
(<-  (date-of "NA" ?i) \!)

; completion date
(<-- (completion-date-of ?date ?i) 
     (q- ?i !pm:COMPLETION-DATE ?d) 
     (q- ?d !t:time ?t) 
     (upi-to-date-string ?t ?date) 
     \!)
(<-  (date-of "NA" ?i) \!)


; creation date
(<-- (creation-date-of ?date ?i) 
     (q- ?i !pm:CREATION-DATE ?d) 
     (q- ?d !t:time ?t) 
     (upi-to-date-string ?t ?date) 
     \!)
(<-  (date-of "NA" ?i) \!)


; milestone
(<-- (is-of-type ?type ?i) (q- ?i !rdf:type ?type))
; (<-- (is-milestone ?i) (q- ?i !rdf:type !pm:MILE-STONE))
(<-- (is-milestone ?i) (is-of-type !pm:MILE-STONE ?i))
(<-- (is-agenda-item ?i) (is-of-type !pm:AGENDA-ITEM ?i))
(<-- (is-action-item ?i) (is-of-type !pm:ACTION-ITEM ?i))
(<-- (is-meeting ?i) (is-of-type !pm:MEETING ?i))
(<-- (is-actor ?i) (is-of-type !pm:ACTOR ?i))

; owner --> generic named property.
;(<-- (owner-of ?owner ?i) (q- ?i !pm:OWNER ?o) (name-of ?owner ?o) \!)
;(<-  (owner-of "NA" ?i) \!)

; comment
(<-- (comment-of ?comment ?i) (q- ?i !pm:COMMENT ?comment) \!)
(<-  (comment-of "NA" ?i) \!)

; comment* --> allow multiple
(<-- (comment-of* ?comment ?i) (q- ?i !pm:COMMENT ?comment) )
(<-  (comment-of* "NA" ?i) \!)

; link
(<-- (link-of ?link ?it) (q- ?it !pm:LINK ?link) \!)
(<-  (link-of "NA" ?it) \!)

; link* --> allow multiple
(<-- (link-of* ?link ?it) (q- ?it !pm:LINK ?link))
(<-  (link-of* "NA" ?it) \!)

; pred-id
(<-- (pred-id-of ?p ?it) (q- ?it !pm:PREDECESSOR ?p) \!)
(<-  (pred-id-of "NA" ?it) \!)

; pred-id* --> allow multiple
(<-- (pred-id-of* ?p ?it) (q- ?it !pm:PREDECESSOR ?p))
(<-  (pred-id-of* "NA" ?it) \!)


(defmacro generic-named-property (name property)
  `(<-- (,name ?x ?id) (q- ?id ,property ?o) (name-of ?x ?o) \!))
(defmacro generic-fall-through (name )
  `(<-  (,name "NA" ?id) \! ))



; discussed in meeting
(generic-named-property discuss-in-meeting !pm:TO-BE-DISCUSSED-IN)
(generic-fall-through discuss-in-meeting )

; applies to subsystem
(generic-named-property applies-to-subsystem !pm:APPLIES-TO-SUBSYSTEM)
(generic-fall-through applies-to-subsystem )

; owner-of
(generic-named-property owner-of !pm:OWNER)
(generic-fall-through owner-of )

; predecessor-of 
(generic-named-property predecessor-of !pm:PREDECESSOR)
(generic-fall-through predecessor-of )


(defmacro s0d (&rest body) `(select0-distinct ,@body ))
(defmacro s0dt (&rest body) `(pwcrt (s0d ,@body)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun unfinished-items ()
  (select (?name ?date ?owner)
          (is-milestone ?i)
          (is-not-done ?i)
          (name-of ?name ?i)
          (date-of ?date ?i)
          (owner-of ?owner ?i)
                 
          ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmacro do-get-all (these)
  `(s0d (?it ?name)
       (is-of-type ?it ,these)
       (name-of ?name ?it)
       ))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun show-ms ()
  (select0-distinct 
   (?id ?name ?owner ?creation ); ?target ); ?completion)
   (is-milestone ?it)
   (id-of ?id ?it)
   (name-of ?name ?it)
   (owner-of ?owner ?it)
   (creation-date-of ?creation ?it)
    ; (target-date-of ?target ?it)
;   (completion-date-of ?completion ?it)
   ))

(defun show-ms-of (sub-sys)
  (select0-distinct (?it ?name ?date ?pid ) ; ?pred-name ?description ?comment ?link)                    
                    (lisp ?s (gen-res::t-integer (gen-res::get-resource-id sub-sys)))
                    (q- ?sub-id !pm:ID ?s)
                    (is-milestone ?it)
                    (name-of ?name ?it)
                    (q- ?it !pm:APPLIES-TO-SUBSYSTEM ?sub-id)
                    (date-of ?date ?it)
                    (pred-id-of* ?pid ?it)
                    ; (q- ?it !pm:PREDECESSOR ?pid)
                    ; (name-of ?pred-name ?pid)
                    ; (description-of ?description ?it)
                    ;(comment-of* ?comment ?it)
                    ;(link-of* ?link ?it)
                    ))

(defun do-ms (sub-sys)
  (let* (
         ( l (show-ms-of sub-sys) )
         ( ll (sort l #'string-lessp :key #'third))
         )
  (print-nested-file ll "d:/r/ms.txt"
                     :column-headers (list "*ID*" "NAME" "DATE" "PRED-ID" "PREDECESSOR" "DESCRIPTION" "COMMENT" "LINK")
                     )))

(defun get-latest-build () 
  (let*
      (
       ( l       ( s0d (?it ?name ?date ?value) 
                     (is-milestone ?it) 
                     (name-of ?name ?it) 
                     (q- ?it !pm:DATE ?d) 
                     (q- ?d !t:time ?t) 
                     (upi-to-date-string ?t ?date) 
                     (q- ?it !pm:VALUE ?value)
                     ) )
       ( ll (sort l #'string-lessp :key #'third))
    )
  ll
  ))

(defmacro glb () `(pwcrt (get-latest-build)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun show-agi-of (mtg-name)
  (select0-distinct (?it ?name ?date ?description ?comment ?link)
                    (lisp ?s (gen-res::t-integer (gen-res::get-resource-id mtg-name)))
                    (q- ?mtg-id !pm:ID ?s)
                    (is-agenda-item ?it)
                    (name-of ?name ?it)
                    (q- ?it !pm:TO-BE-DISCUSSED-IN ?mtg-id)
                    (description-of ?description ?it)
                    (is-not-done ?it)
                    (comment-of ?comment ?it)
                    (link-of ?link ?it)
                    (date-of ?date ?it)
          ))

(defun do-agenda (mtg)
;;;  (let* (
;;;         ( l (show-agi-of mtg) )
;;;         ( ll (sort l #'string-lessp :key #'third))
;;;         )
;;;    (loop for i from 0 to (length ll) do
;;;          (let* (
;;;                 ( q (third (nth i ll )))
;;;                 ( s (length q) )
;;;                 ( qq (if (< s 10) q (subseq q 0 10) ) )
;;;                 )
;;;            (setf (nth i ll) qq)
;;;            )
;;;          )
  (print-nested-file (show-agi-of mtg) "d:/r/agenda.txt"
                     :column-headers (list "*ID*" "NAME" "DATE" "DESCRIPTION" "COMMENT" "LINK")
                     ))


(defun list-all-meetings ()
  (s0d (?it ?name) (is-meeting ?it) (name-of ?name ?it)))

(defmacro lam () (pwcrt (list-all-meetings)))

(defparameter *help-stuff*
    (list 
     (list "(cnuo)" "commit-named-univere and leave open")
     (list "(do-agenda mtg)" "do agenda for a meeting --> excel")
     (list "(ea-id #)" "everything about id #")
     (list "(glb)" "get latest build")
     (list "(lam)" "list all meetings")
     )
  )

(defmacro h () (pwcrt *help-stuff*))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun everything-about-id (i)
  (select0-distinct (?p ?o)
          (lisp ?ii (gen-res::t-integer (if (listp i) (gen-res::get-resource-id i) i)))
          (q- ?it !pm:ID ?ii)
          (q- ?it ?p ?o)
                    ))

(defmacro ea-id (i) `(pwcrt (everything-about-id ,i)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun all-my-action-items ()
  (s0d (?it ?name ?owner-name ?priority)
       (is-action-item ?it)
       (name-of  ?name ?it)
       (q- ?it !pm:OWNER !pmi:9523343728)
       (owner-of ?owner-name ?it)
       (is-not-done ?it)
       (priority-of ?priority ?it)
       ))

(defun ai! () (print-nested-file (all-my-action-items) "d:/r/cgelamb.txt"
                                 :column-headers (list "*ID*" "NAME" "OWNER-NAME" "PRIORITY")
                                 ))

(defun show-actors ()
  (s0d (?it ?name)
       (is-actor ?it)
       (name-of ?name ?it)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;(defun osp-ota-agenda ()
;;;  (select (?id ?name ?description ?comment ?link)
;;;          (is-agenda-item ?it)
;;;          (id-of ?id ?it)
;;;          (name-of ?name ?it)
;;;          (description-of ?description ?it)
;;;          (q- ?it !pm:TO-BE-DISCUSSED-IN !pmi:1509275105)
;;;          ; (applies-to-subsystem ?subsystem ?it)
;;;          (is-not-done ?it)
;;;          (comment-of ?comment ?it)
;;;          (link-of ?link ?it)
;;;          ))
;;;
;;;(defun sr3-ccb-agenda ()
;;;  (select (?id ?name ?description ?comment ?link)
;;;          (is-agenda-item ?it)
;;;          (id-of ?id ?it)
;;;          (name-of ?name ?it)
;;;          (description-of ?description ?it)
;;;          (q- ?it !pm:TO-BE-DISCUSSED-IN !pmi:4244345226)
;;;          ; (applies-to-subsystem ?subsystem ?it)
;;;          (is-not-done ?it)
;;;          (comment-of ?comment ?it)
;;;          (link-of ?link ?it)
;;;          ))


;;;(defmacro agenda-printer (fn cols file-out)
;;;  `(print-nested-file (,fn)  ,file-out :column-headers ,cols )  )

;;;
;;;(defmacro do-agenda () 
;;;  `(agenda-printer ga-agenda 
;;;                   (list "*ID*" "NAME" "DESCRIPTION" "COMMENT") 
;;;                   "d:/r/osp-agenda.txt"))
;;;
;;;(defmacro do-osp-agenda () 
;;;  `(agenda-printer osp-ota-agenda 
;;;                   (list "*ID*" "NAME" "DESCRIPTION" "COMMENT" "LINK") 
;;;                   "d:/r/osp-agenda.txt"))
;;;
;;;(defmacro do-sr3-agenda () 
;;;  `(agenda-printer sr3-ccb-agenda 
;;;                   (list "*ID*" "NAME" "DESCRIPTION" "COMMENT" "LINK") 
;;;                   "d:/r/sr3-ccb-agenda.txt"))
;;;
;;;(defun print-all (n &optional out)
;;;  (format out "~{~a~%~}" n)
;;;  (format out "~a~%" (length n)))
;;;(defun ga-agenda ()
;;;  (select (?id ?name ?description ?meeting ?subsystem ?done ?comment)
;;;          (is-agenda-item ?it)
;;;          (id-of ?id ?it)
;;;          (name-of ?name ?it)
;;;          (description-of ?description ?it)
;;;          (discuss-in-meeting ?meeting ?it)
;;;          (applies-to-subsystem ?subsystem ?it)
;;;          (doneness ?done ?it)
;;;          (comment-of ?comment ?it)
;;;          ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun q-repl ()
    (let ((cmd (q-read)))
        (unless (eq (car cmd) 'quit)
            (q-print (q-eval cmd))
            (q-repl))))

(defun q-read ()
    (let ((cmd (read-from-string (concatenate 'string "(" (read-line) ")"))))
         (flet ((quote-it (x)
                    (list 'quote x)))
           (cons (car cmd) (mapcar #'quote-it (cdr cmd))))))


(defun new-res ()
  (gen-res::commit-resource-as-list (list 'res 'actor 'id 9523343728 'name "pma"))
  )

(defun q-sort (l) l )

(defun list-resources() (q-sort gen-res::*the-subject-list* ))



(defparameter *allowed-commands* '(new-res triple-count help list-resources cnuo do-agenda ea-id glb lam))

(defun help () (q-sort *allowed-commands* ))

(defun q-eval (sexp)
    (if (member (car sexp) *allowed-commands*)
        (eval sexp)
        '(i do not know that command.)))

(defun tweak-text (lst caps lit)
  (when lst
    (let ((item (car lst))
          (rest (cdr lst)))
      (cond ((eql item #\space) (cons item (tweak-text rest caps lit)))
            ((member item '(#\! #\? #\.)) (cons item (tweak-text rest t lit)))
            ((eql item #\") (tweak-text rest caps (not lit)))
            (lit (cons item (tweak-text rest nil lit)))
            (caps (cons (char-upcase item) (tweak-text rest nil lit)))
            (t (cons (char-downcase item) (tweak-text rest nil nil)))))))

(defun q-print (lst)
  (princ (coerce (tweak-text (coerce (string-trim "() " (prin1-to-string lst)) 'list) t nil) 'string))
  (princ #\newline)
  (princ ">")

    (fresh-line))

        

